home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / you-075a.lha / you-075a / read.c < prev    next >
C/C++ Source or Header  |  1992-06-18  |  17KB  |  680 lines
  1. /* ******************************************************************** */
  2. /*  read.c           Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* Input functions                                            */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * Change Log:
  9.  *   Version 1, April 1989
  10.  *   Version 2, May 1989
  11.  *    Changed whole system to add stream argument everywhere
  12.  *    Made curchar part of the stream structure, and consequent changes
  13.  *     include removal of re-initialise-io
  14.  */
  15.  
  16. #include <stdio.h>
  17. #include <string.h>
  18. #include <ctype.h>
  19. #ifndef DONT_HAVE_STDLIB_H
  20. #include <stdlib.h>
  21. #endif
  22. #include "funcalls.h"
  23. #include "defs.h"
  24. #include "structs.h"
  25. #include "error.h"
  26. #include "global.h"
  27. #include "garbage.h"
  28.  
  29. #include "symboot.h"
  30.  
  31.  
  32. extern FILE *yyin;
  33. static int boffop;
  34. static char boffo[255];
  35. LispObject q_eof, q_rpar, q_period, q_lpar, q_quotemark,
  36.            q_backquotemark, q_comma, q_at;
  37. LispObject sym_quote;
  38.  
  39. int ttype;
  40.  
  41. #define NO_CHARACTER    0x1000000
  42.  
  43. LispObject readnumber(LispObject*,int);
  44. LispObject readinteger(LispObject*,int);
  45. LispObject readidentifier(LispObject*,int);
  46. LispObject readstring(LispObject*);
  47. LispObject readatom(LispObject*);
  48. LispObject read1(LispObject*);
  49. LispObject Fn_endofstreamcharp(LispObject*);
  50. LispObject Fn_endoflinecharp(LispObject*);
  51. LispObject Fn_read_ln(LispObject*);
  52. LispObject Fn_readchar(LispObject*);
  53. LispObject Fn_readbyte(LispObject*);
  54. LispObject Fn_peekchar(LispObject*);
  55. LispObject Fn_peekbyte(LispObject*);
  56.  
  57. LispObject lookupname(LispObject*, int);
  58. LispObject ascii(LispObject*,int);
  59. LispObject numob(LispObject*,int);
  60. LispObject floatob(LispObject*,int);
  61. LispObject sym_quasiquote;
  62. LispObject sym_unquote;
  63. LispObject sym_unquote_splicing;
  64. LispObject current_input;
  65.  
  66. void initialise_input(LispObject *stacktop)
  67. {
  68.   LispObject fun;
  69.  
  70. #ifdef WITH_FUDGE
  71.   {
  72.     void initialise_fudge(void);
  73.     initialise_fudge();
  74.   }
  75. #endif
  76.  
  77.   q_eof = allocate_char(stacktop,(char) EOF);    
  78.   add_root(&q_eof);
  79.   q_lpar = allocate_char(stacktop,'(');
  80.   add_root(&q_lpar);
  81.   q_rpar = allocate_char(stacktop,')');
  82.   add_root(&q_rpar);
  83.   q_period = allocate_char(stacktop,'.');
  84.   add_root(&q_period);
  85.   q_quotemark = allocate_char(stacktop,'\'');
  86.   add_root(&q_quotemark);
  87.   q_backquotemark = allocate_char(stacktop,'`');
  88.   add_root(&q_backquotemark);
  89.   q_comma = allocate_char(stacktop,',');
  90.   add_root(&q_comma);
  91.   q_at = allocate_char(stacktop,'@');
  92.   add_root(&q_at);
  93.   sym_quasiquote = (LispObject) get_symbol(stacktop,"quasiquote");
  94.   add_root(&sym_quasiquote);
  95.   sym_unquote = (LispObject) get_symbol(stacktop,"unquote");
  96.   add_root(&sym_unquote);
  97.   sym_unquote_splicing = (LispObject) get_symbol(stacktop,"unquote-splicing");
  98.   add_root(&sym_unquote_splicing);
  99.   make_module_function(stacktop,"read",Fn_read,1);
  100.   (void) make_module_function(stacktop,"end-of-line-p",Fn_endoflinecharp,1);
  101.   fun = make_module_function(stacktop,"read-char",Fn_readchar,1);
  102.   fun = make_module_function(stacktop,"read-byte",Fn_readbyte,1);
  103.   fun = make_module_function(stacktop,"peek-char",Fn_peekchar,1);
  104.   fun = make_module_function(stacktop,"peek-byte",Fn_peekbyte,1);
  105.   fun = make_module_function(stacktop,"read-with-line-numbers",Fn_read_ln,1);
  106.   IGNORE(fun);
  107. }
  108.  
  109. static LispObject read0(LispObject *stacktop)
  110. {
  111.   LispObject k = readatom(stacktop);    /* First token in list */
  112.  
  113.   if (ttype==3) {
  114.     if (k==q_lpar) return read1(stacktop);
  115.     if (k==q_quotemark) {
  116.       ttype = 5;        /* A list */
  117.       k = read0(stacktop);    /* Thing to be QUOTEd */
  118.       EUCALLSET_2(k, Fn_cons, k, nil);
  119.       return EUCALL_2(Fn_cons, sym_quote, k);
  120.     }
  121.     else if (k==q_backquotemark) {
  122.       ttype = 5;        /* A list */
  123.       k = read0(stacktop);    /* Thing to be QUOTEd */
  124.       EUCALLSET_2(k, Fn_cons, k, nil);
  125.       return EUCALL_2(Fn_cons, sym_quasiquote, k);
  126.     }
  127.     else if (k==q_comma) {
  128.       EUCALLSET_1(k, Fn_peekchar, current_input);   /* Are we splicing ? */
  129.       if (k->CHAR.code=='@') {
  130.     EUCALL_1(Fn_readchar, current_input);
  131.     ttype = 5;
  132.     k = read0(stacktop);
  133.     EUCALLSET_2(k, Fn_cons, k,nil);
  134.     return EUCALL_2(Fn_cons, sym_unquote_splicing,k);
  135.       }
  136.       ttype = 5;        /* A list */
  137.       k = read0(stacktop);    /* Thing to be QUOTEd */
  138.       EUCALLSET_2(k, Fn_cons, k,nil);
  139.       return EUCALL_2(Fn_cons, sym_unquote, k);
  140.     }
  141.     else return k;        /* ttype=3 -> just pass it back */
  142.     }
  143.   ttype = 5;
  144.   return k;            /* entire list is atomic */
  145. }
  146.  
  147. #define packchar(ch) boffo[boffop++] = ch
  148.  
  149. LispObject read1(LispObject *stacktop)
  150. {
  151.     LispObject l=read0(stacktop);
  152.     LispObject k=nil;
  153.  
  154.     if (ttype==3)
  155.     if (l==q_rpar || l==q_eof) return nil;
  156.  
  157.     EUCALLSET_2(k, Fn_cons, nil, nil);
  158.  
  159.     CAR(k) = l;
  160.     l = k;
  161.     while (TRUE) {
  162.       LispObject m=read0(stacktop);
  163.       if (ttype==3) {
  164.     if (m==q_period) {
  165.       CDR(l) = read0(stacktop);
  166.       m = read0(stacktop);
  167.       if ((ttype!=3) || m!=q_rpar)
  168.        (void) CallError(stacktop,
  169.                 "Trouble reading dot notation",nil,NONCONTINUABLE);
  170.       ttype = 5;
  171.       return k;
  172.      }
  173.     else if (m==q_rpar || m==q_eof) {
  174.       ttype = 5; return k;
  175.      }
  176.       }
  177.       EUCALLSET_2(m, Fn_cons, m, nil); /* Saved in cons */
  178.     CDR(l) = m;
  179.     l = m;
  180.     }
  181.     return(nil);
  182.   }
  183.  
  184. int nextchar()
  185. {
  186.     if ((current_input->STREAM).curchar==0) {
  187.       (current_input->STREAM).curchar = getc((current_input->STREAM).handle);
  188.       if ((current_input->STREAM).curchar==EOF) goto seteof;
  189.     }
  190.     {
  191.       int k = ((current_input->STREAM).curchar)&0xff;
  192.       if (k!=0xff)
  193.     (current_input->STREAM).curchar = ((current_input->STREAM).curchar)>>8;
  194.       return k;
  195.     }
  196. seteof:
  197.     (current_input->STREAM).curchar = 0xff;    /* END OF FILE MARKER */
  198.     return 0xff;
  199.   }
  200.  
  201. /* pushchar(,k) arranges that when nextchar is next called */
  202. /* it will return the value k, but after re-reading k */ 
  203. /* it will revert to normal operation. up to three pushed */
  204. /* characters can be pending. various special values are */ 
  205. /* pushed to allow for for complicated actions. pushchar(,eof) */ 
  206. /* has no effect. */
  207. void pushchar(LispObject *stacktop, int k)
  208. {
  209.   if (k==0xff) {
  210.     if ((((current_input->STREAM).curchar)&0xff0000)!=0)
  211.       (void) CallError(NULL,"pushchar overflow on code ~d",
  212.                allocate_integer(stacktop,k),NONCONTINUABLE);
  213.     return;
  214.   }
  215.   (current_input->STREAM).curchar = (((current_input->STREAM).curchar)<<8)+k;
  216.   return;
  217. }
  218.  
  219. LispObject read_long_name(LispObject *stacktop, int initial, char *name)
  220. {
  221.   int k = nextchar();
  222.   int i;
  223.  
  224.   if (k != name[1] && k != toupper(name[1])) { /* it was a simple #\s etc */
  225.     pushchar(stacktop,k);
  226.     return allocate_char(stacktop, initial);
  227.   }
  228.   for (i = 2; i < strlen(name); i++) {
  229.     k = nextchar();
  230.     if (k != name[i] && k != toupper(name[i]))
  231.       return CallError(stacktop, "bad character escape",
  232.                allocate_string(stacktop, name, strlen(name)),
  233.                CONTINUABLE);
  234.   }
  235.   switch (name[0]) {
  236.   case 's': return allocate_char(stacktop, ' ');
  237.   case 'n': return allocate_char(stacktop,'\n');
  238.   case 'r': return allocate_char(stacktop,'\r');
  239.   case 't': return allocate_char(stacktop,'\t');
  240.   }
  241.   return NULL;            /* dummy return */
  242. }
  243.  
  244. LispObject read_character(LispObject *stacktop)
  245. {
  246.   int k = nextchar();
  247.  
  248.   switch (k) {
  249.   case 's': case 'S':
  250.     return read_long_name(stacktop, k, "space");
  251.   case 'n': case 'N':
  252.     return read_long_name(stacktop, k, "newline");
  253.   case 'r': case 'R':
  254.     return read_long_name(stacktop, k, "return");
  255.   case 't': case 'T':
  256.     return read_long_name(stacktop, k, "tab");
  257.   }
  258.   return allocate_char(stacktop, k);
  259. }
  260.  
  261. LispObject readatom(LispObject *stacktop)
  262. {
  263.   int k=nextchar(); /* FIRST CHARACTER OF ATOM, MAYBE */
  264.  
  265.   boffop = 0;
  266.   /* decide what sort of atom it might be... */
  267.  top: 
  268.   switch (k) {
  269.   case '"':
  270.     return readstring(stacktop);
  271.   case '\\':
  272.     k = nextchar();
  273.     if (k==0xff)
  274.       (void) CallError(NULL, "\\ followed by end of file is illegal",
  275.                nil,NONCONTINUABLE);
  276.     
  277.   case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
  278.   case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
  279.   case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
  280.   case 's': case 't': case 'u': case 'v': case 'w': case 'x':
  281.   case 'y': case 'z':
  282.   case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
  283.   case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
  284.   case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
  285.   case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
  286.   case 'Y': case 'Z':
  287.   case '_': case '=': case '*': case '<': case '>': case '/':
  288.     return readidentifier(stacktop,k);
  289.  
  290.   case '-': case '+':
  291.     packchar(k);        /* PROBABLY A USEFUL THING TO DO */
  292.     k = nextchar();
  293.     if (isdigit(k)) goto numeric;
  294.     pushchar(stacktop,k);
  295.     --boffop; /* HACK !! */
  296.     return readidentifier(stacktop,boffo[0]);
  297.  
  298.   case '(': case ')': case '.': case '\'': case '`': case ',':
  299.     ttype  =  3;
  300.     return ascii(stacktop,k);
  301.  
  302.   case ';':
  303.     while (getc((current_input->STREAM).handle) != '\n');
  304.     return readatom(stacktop);
  305.  
  306.   case EOF:
  307.   case 0xff:
  308.     ttype = 3;
  309.     return q_eof;
  310.  
  311.   case '#':
  312.     k = nextchar();
  313.     switch (k) {
  314.     case '\\':            /* a character */
  315.       return read_character(stacktop);
  316.     default:
  317.       (void)CallError(stacktop,
  318.               "unknown escape character",allocate_char(stacktop,k),
  319.               NONCONTINUABLE);
  320.     }
  321.  
  322.   numeric:
  323.   case '0': case '1': case '2': case '3': case '4':
  324.   case '5': case '6': case '7': case '8': case '9':
  325.     return readnumber(stacktop,k);
  326.  
  327.   case ' ': case '\t': case '\n':
  328.     k = nextchar();
  329.     goto top;            /* restart readatom */
  330.  
  331.   default:
  332.     (void) CallError(stacktop, "classification type in readatom ~d",
  333.              allocate_integer(stacktop,k),NONCONTINUABLE);
  334.   }
  335.   return nil;
  336. }
  337.  
  338. LispObject readidentifier(LispObject *stacktop, int k)
  339. {
  340.   ttype = 0;
  341.   while (TRUE) {
  342.     packchar(k);
  343.     k = nextchar();        /* look at next character */
  344.     if (k=='\\') {
  345.       k = nextchar();
  346.       if (k==0xff)
  347.     CallError(NULL,
  348.           "\\ followed by end of file is illegal",nil,NONCONTINUABLE);
  349.     }                /* classify as a letter */
  350.     else if (!isalnum(k) &&
  351.          k!='_' && k!='-' && k!='>' && k!='<' &&
  352.          k!='=' && k!='/' && k!='*')
  353.       break;
  354.   }
  355.   packchar('\0');        /* C string terminator */
  356.   pushchar(stacktop,k);    /* the terminator character has not been read, logically */
  357.   return lookupname(stacktop,boffop);
  358. }
  359.  
  360. LispObject readstring(LispObject *stacktop)
  361. {
  362.   /* I just read a " mark, so now I want to read in a string */
  363.   int k=0;
  364.  
  365.   ttype = 1;
  366. top:
  367.   k = nextchar();
  368.   if (k==0xff) (void) CallError(stacktop,
  369.                 "end of file in a string",nil,NONCONTINUABLE);
  370.   if (k=='\\') {
  371.     k = nextchar();
  372.     switch (k) {
  373.     case 'n':
  374.       k = '\n';
  375.       break;
  376.     case 'r':
  377.       k = '\r';
  378.       break;
  379.     case 't':
  380.       k = '\t';
  381.       break;
  382.     case 'p':
  383.       k = '\f';
  384.       break;
  385.     default:
  386.       break;
  387.     }
  388.   }
  389.   else if (k=='"')  /* probably end of string */
  390.     goto stringcomplete;
  391.   boffo[boffop++] = k;
  392.   if (boffop>250) (void) CallError(stacktop,
  393.                    "string too long",nil,NONCONTINUABLE);
  394.   goto top;
  395.  
  396.  stringcomplete:
  397.   packchar('\0');
  398.   return allocate_string(stacktop, boffo,boffop);
  399. }
  400.  
  401. LispObject readinteger(LispObject *stacktop, int k)
  402. {
  403. /* k is the first character of the number, and is a + or - or a digit */
  404.     ttype = 2;
  405.  
  406.     while (TRUE) {
  407.       packchar(k);
  408.       k = nextchar();
  409.       if (!isdigit(k)) break;
  410.     }
  411. /* here at end of integer */
  412.     pushchar(stacktop,k);
  413.     packchar('\0');
  414.     return numob(stacktop,boffop-1);
  415. }
  416.  
  417. LispObject readnumber(LispObject *stacktop, int k)
  418. {
  419.   int pointflag = FALSE;
  420.   char lastk = k;
  421.  
  422.   /* k as above... */
  423.  
  424.   ttype = 2;
  425.  
  426.   while (TRUE) {
  427.     packchar(k);
  428.     k = nextchar();
  429.     if (!isdigit(k) && !(k == '.' && !pointflag)) break;
  430.     if (k == '.') pointflag = TRUE;
  431.     lastk = k;
  432.   }
  433.  
  434.   /* End of number */
  435.  
  436.   if (lastk == '.') {
  437.     pushchar(stacktop,lastk);
  438.     --boffop;
  439.     pointflag = FALSE;
  440.   }
  441.  
  442.   pushchar(stacktop,k);
  443.   packchar('\0');
  444.  
  445.   if (pointflag) return(floatob(stacktop,boffop-1));
  446.  
  447.   return(numob(stacktop,boffop-1));
  448. }
  449.   
  450.                 /* See following function as well */
  451. EUFUN_1( Fn_read, stream)
  452. {
  453.   extern LispObject Fn_Lex_Yacc_reader(LispObject*,FILE *);
  454.   LispObject k=nil;
  455.  
  456.   if (stream==NULL || stream==nil)
  457.     current_input = StdIn;
  458.   else {
  459.          current_input = stream;
  460.   }
  461.  
  462. /*
  463.   while (TRUE) {
  464.     OFF_collect();
  465.     k = read0(stacktop);
  466.     ON_collect();
  467.     if (ttype == 3) {
  468.       if (k==q_eof) {
  469.     if (eofflag) (void) CallError("end of file",nil,NONCONTINUABLE);
  470.     eofflag = TRUE;
  471.     return q_eof;
  472.       }
  473.       else if (k == q_rpar) {
  474.     eofflag = FALSE;
  475.     continue;
  476.       }
  477.     }
  478.     eofflag = FALSE;
  479.     return k;
  480.   }
  481.   return(nil);
  482. */
  483.   
  484.   if (current_input->STREAM.handle == NULL) 
  485.     CallError(stacktop, "read: null stream",current_input,NONCONTINUABLE);
  486.  
  487.   OFF_collect(); 
  488.   k=Fn_Lex_Yacc_reader(stacktop, current_input->STREAM.handle);
  489.   ON_collect(); 
  490.  
  491.   if (current_input!=StdIn) yyin=stdin;
  492.  
  493.   return k;
  494.  
  495. }
  496. EUFUN_CLOSE
  497.  
  498. /* Same as Fn_read, except it has line number information */
  499. EUFUN_1( Fn_read_ln, stream)
  500. {
  501.   extern LispObject Fn_Lex_Yacc_reader_linenos(LispObject*,FILE *);
  502.   LispObject k=nil;
  503.  
  504.   if (stream==NULL || stream==nil)
  505.     current_input = StdIn;
  506.   else {
  507.          current_input = stream;
  508.   }
  509.  
  510.   if (current_input->STREAM.handle == NULL) 
  511.     CallError(stacktop, "read: null stream",current_input,NONCONTINUABLE);
  512.  
  513.   OFF_collect(); 
  514.   k=Fn_Lex_Yacc_reader_linenos(stacktop, current_input->STREAM.handle);
  515.   ON_collect(); 
  516.  
  517.   if (current_input!=StdIn) yyin=stdin;
  518.   return k;
  519. }
  520. EUFUN_CLOSE
  521.   
  522. LispObject ascii(LispObject *stacktop,int n)
  523. {
  524.   boffo[0]=n;
  525.   if (boffo[0]=='(') return q_lpar;
  526.   if (boffo[0]==')') return q_rpar;
  527.   if (boffo[0]=='.') return q_period;
  528.   if (boffo[0]=='\'') return q_quotemark;
  529.   if (boffo[0]=='`') return q_backquotemark;
  530.   if (boffo[0]==',') return q_comma;
  531.   return lookupname(stacktop,1);
  532. }
  533.  
  534. LispObject floatob(LispObject *stacktop, int len)
  535. {
  536.   double f;
  537.  
  538.   IGNORE(len);
  539.  
  540.   if (boffo[0] == '-') {
  541.     if (sscanf(boffo,"-%lf",&f) != 1)
  542.       return(get_symbol(stacktop,"-"));
  543.     else
  544.       return(allocate_float(stacktop, -f));
  545.   }
  546.   if (boffo[0] == '+') {
  547.     if (sscanf(boffo,"+%lf",&f) != 1)
  548.       return(get_symbol(stacktop,"+"));
  549.     else
  550.       return(allocate_float(stacktop, f));
  551.   }
  552.   sscanf(boffo,"%lf",&f);
  553.   return(allocate_float(stacktop, f));
  554. }
  555.          
  556. LispObject numob(LispObject *stacktop, int len)
  557. {
  558.                 /* temporary: small integer only */
  559.   if (boffo[0]=='-') {
  560.     if (sscanf(boffo,"-%d",&len) != 1)
  561.       return(get_symbol(stacktop,"-"));
  562.     else
  563.       return allocate_integer(stacktop, -len);
  564.   }
  565.   if (boffo[0]=='+') {
  566.     if (sscanf(boffo,"+%d",&len) != 1) 
  567.       return(get_symbol(stacktop,"+"));
  568.     else
  569.       return allocate_integer(stacktop, len);
  570.   }
  571.   sscanf(boffo,"%d",&len);
  572.   return allocate_integer(stacktop, len);
  573. }
  574.     
  575.  
  576. LispObject lookupname(LispObject *stacktop, int len)
  577. {
  578.   LispObject i;
  579.  
  580.   IGNORE(len);
  581.   for(i = (ObList); i!=NULL; i = i->SYMBOL.left) {
  582.     if (strcmp(boffo,stringof(i->SYMBOL.pname))==0) {
  583.       return i;
  584.     }
  585.   }
  586.  
  587.   { /* char *malloc(); */
  588.  
  589.     char *tmp = malloc(len);
  590.     strcpy(tmp,boffo);
  591.     return (LispObject)get_symbol(stacktop,tmp);
  592.   }
  593. }
  594.  
  595. EUFUN_1( Fn_endofstreamcharp, obj)
  596. {
  597.   return (is_char(obj) && (obj->CHAR).code==EOF ? lisptrue : nil);
  598. }
  599. EUFUN_CLOSE
  600.  
  601. EUFUN_1( Fn_endoflinecharp, obj)
  602. {
  603.   return (is_char(obj) && (obj->CHAR).code=='\n' ? lisptrue : nil);
  604. }
  605. EUFUN_CLOSE
  606.  
  607. EUFUN_1( Fn_readchar, stream)
  608. {
  609.   int k;
  610.  
  611.   if (stream==NULL || stream==nil) current_input = StdIn;
  612.   else current_input = stream;
  613.   yyin = (current_input->STREAM).handle;
  614. #ifdef WITH_FUDGE
  615.   {
  616.     extern void yy_reset_stream(FILE *);
  617.     yy_reset_stream(current_input->STREAM.handle);
  618.   }
  619. #endif
  620.   k = getc((current_input->STREAM).handle);
  621.   return (LispObject) (( k == EOF) ? q_eof : allocate_char(stacktop, (char)k));
  622. }
  623. EUFUN_CLOSE
  624.   
  625. EUFUN_1( Fn_readbyte, stream)
  626. {
  627.   int k;
  628.   /*++IGNORE(env);*/
  629.  
  630.   if (stream==NULL || stream==nil) current_input = StdIn;
  631.   else current_input = stream;
  632. #ifdef WITH_FUDGE
  633.   {
  634.     extern void yy_reset_stream(FILE *);
  635.     yy_reset_stream(current_input->STREAM.handle);
  636.   }
  637. #endif
  638.   k = getc((current_input->STREAM).handle);
  639.   return (LispObject) allocate_integer(stacktop, k);
  640. }
  641. EUFUN_CLOSE
  642.   
  643. EUFUN_1( Fn_peekchar, stream)
  644. {
  645.   char k;
  646.  
  647.   if (stream==NULL || stream==nil) current_input = StdIn;
  648.   else current_input = stream;
  649. #ifdef WITH_FUDGE
  650.   {
  651.     extern void yy_reset_stream(FILE *);
  652.     yy_reset_stream(current_input->STREAM.handle);
  653.   }
  654. #endif
  655.   k = getc((current_input->STREAM).handle);
  656.   ungetc(k,(current_input->STREAM).handle);
  657.   return (LispObject) allocate_char(stacktop,k);
  658. }
  659. EUFUN_CLOSE
  660.   
  661. EUFUN_1( Fn_peekbyte, stream)
  662. {
  663.   char k;
  664.   /*++IGNORE(env);*/
  665.  
  666.   if (stream==NULL || stream==nil) current_input = StdIn;
  667.   else current_input = stream;
  668. #ifdef WITH_FUDGE
  669.   {
  670.     extern void yy_reset_stream(FILE *);
  671.     yy_reset_stream(current_input->STREAM.handle);
  672.   }
  673. #endif
  674.   k = getc((current_input->STREAM).handle);
  675.   ungetc(k,(current_input->STREAM).handle);
  676.   return (LispObject) allocate_integer(stacktop, k);
  677. }
  678. EUFUN_CLOSE
  679.  
  680.